home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / XPK-PCQ / XpkPack.p < prev   
Text File  |  1997-05-06  |  2KB  |  67 lines
  1. Program XpkPack;
  2.  
  3. { XpkPack 1995 by Andreas Tetzl }
  4.  
  5. {$I "Include:Libraries/xpk.i"}
  6. {$I "Include:Utils/TagUtils.i"}
  7. {$I "Include:Utility/Utility.i"}
  8. {$I "Include:Utility/Hooks.i"}
  9. {$I "Include:Exec/Libraries.i"}
  10. {$I "Include:Utils/StringLib.i"}
  11. {$I "Include:Utils/Parameters.i"}
  12.  
  13. VAR TagList : Address;
  14.     res : Integer;
  15.     err : String;
  16.     arg1, arg2, arg3 : String;
  17.     ChunkHook : Hook;
  18.     prog : XpkProgressPtr;
  19.  
  20. PROCEDURE CleanExit(Why : String; RC : Integer);
  21. BEGIN
  22.  If XpkMasterBase<>NIL then CloseLibrary(XpkMasterBase);
  23.  If UtilityBase<>NIL then CloseLibrary(UtilityBase);
  24.  If Why<>NIL then Writeln(Why);
  25.  Exit(RC);
  26. END;
  27.  
  28. FUNCTION ChunkFunc : Integer;
  29. BEGIN
  30.  {$A    move.l  a1,_prog    }
  31.  Write("\r",prog^.packername,": ",prog^.done,"% done");
  32.  ChunkFunc:=0;
  33. END;
  34.  
  35. BEGIN
  36.  arg1:=AllocString(50);
  37.  arg2:=AllocString(50);
  38.  arg3:=AllocString(50);
  39.  err:=AllocString(XPKERRMSGSIZE);
  40.  
  41.  GetParam(1,arg1);
  42.  GetParam(2,arg2);
  43.  GetParam(3,arg3);
  44.  
  45.  If (StrEq(arg1,"")) or (StrEq(arg1,"?")) then CleanExit("XpkPack inname outname method",0);
  46.  
  47.  UtilityBase:=OpenLibrary("utility.library",0);
  48.  If UtilityBase=NIL then CleanExit("Can't opne utility.library",20);
  49.  
  50.  XpkMasterBase:=OpenLibrary(XPKNAME,0);
  51.  If XpkMasterBase=NIL then CleanExit("Can't open XpkMaster.library",10);
  52.  
  53.  ChunkHook.h_entry:=adr(ChunkFunc);
  54.  TagList:=CreateTagList(xpk_InName,arg1,
  55.                         xpk_OutName,arg2,
  56.                         xpk_FindMethod,arg3,
  57.                         xpk_GetError,err,
  58.                         xpk_ChunkHook,adr(ChunkHook),
  59.                         xpk_NoClobber,TRUE);
  60.  res:=XpkPack(TagList);
  61.  FreeTagItems(TagList);
  62.  Writeln;
  63.  If res<>XPKERR_OK then CleanExit(err,10);
  64.  
  65.  CleanExit(NIL,0);
  66. END.
  67.